home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Video Toaster 4.3
/
Video Toaster v4.3.iso
/
3.1
/
toasterall
/
arexx_examples
/
lwm
/
prick.lwm
< prev
next >
Wrap
Text File
|
1993-06-06
|
4KB
|
197 lines
/* CMD: Random Surface Points
*
* Generate a set of points randomly distributed across the surface of
* an object by pricking it with many tiny needles.
*/
syscode = "Random Surface Points"
statfil = 'T:RandomPoints.state'
version = 'Prick v1.0'
/* Boilerplate.
*/
mxx="LWModelerARexx.port"
signal on error
signal on syntax
mxx_add = addlib(mxx,0)
if (~mxx_add) then exit
call addlib("rexxmathlib.library",0,-30,0)
call main
if (mxx_add) then call remlib(mxx)
exit
syntax:
error:
t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
if (mxx_add) then call remlib(mxx)
exit
MAIN:
fg = curlayer()
emp = emptylayers()
if (words(emp) = 0) then do
call notify(1,"!Need a background layer for scratch work.")
return
end
temp = word(emp,1)
if (setup() = 0) then return
/* Get bounding box for fg data.
*/
parse value boundingbox() with n x1 x2 y1 y2 z1 z2 .
if (n = 0) then return
lo = x1 y1 z1
hi = x2 y2 z2
dx = x2 - x1
dy = y2 - y1
dz = z2 - z1
/* Compute our slightly expanded box for the ends of the needles.
*/
exb = max(dx, dy, dz) / 20
xx1 = x1 - exb
xx2 = x2 + exb
yy1 = y1 - exb
yy2 = y2 + exb
zz1 = z1 - exb
zz2 = z2 + exb
/* Compute distribution cell size. We want about "num" points
* distributed along the surface of the bounding box, so take that
* surface area, divide by num. Square root of that is the cell
* edge size (s). Also compute min allowed distance (md) and
* tiny delta for needle construction (d).
*/
sa = 2 * (dx * dy + dy * dz + dz * dx)
s = sqrt(sa / num)
md = s / 4
d = md / 20
say "Cell edge size:" s " Merge dist:" md
/* Goto background layer and build our lattice of needles.
*/
call setlayer(temp)
call add_begin()
nx = dx % s
ny = dy % s
nz = dz % s
say "Needle grid" nx ny nz
call meter_begin(nx * ny + nx * nz + ny * nz, syscode)
do xi=1 to nx
x0 = x1 + (x2 - x1) / nx * (xi - 0.5)
do yi=1 to ny
y0 = y1 + (y2 - y1) / ny * (yi - 0.5)
xa = x0 + (randu()-0.5) * s
xb = x0 + (randu()-0.5) * s
ya = y0 + (randu()-0.5) * s
yb = y0 + (randu()-0.5) * s
i1 = add_point(xa ya zz1)
i2 = add_point(xa ya+d zz1)
i3 = add_point(xb yb zz2)
call add_polygon(i1 i2 i3)
call meter_step()
end yi
end xi
do xi=1 to nx
x0 = x1 + (x2 - x1) / nx * (xi - 0.5)
do zi=1 to nz
z0 = z1 + (z2 - z1) / nz * (zi - 0.5)
xa = x0 + (randu()-0.5) * s
xb = x0 + (randu()-0.5) * s
za = z0 + (randu()-0.5) * s
zb = z0 + (randu()-0.5) * s
i1 = add_point(xa yy1 za)
i2 = add_point(xa yy1 za+d)
i3 = add_point(xb yy2 zb)
call add_polygon(i1 i2 i3)
call meter_step()
end zi
end xi
do yi=1 to ny
y0 = y1 + (y2 - y1) / ny * (yi - 0.5)
do zi=1 to nz
z0 = z1 + (z2 - z1) / nz * (zi - 0.5)
ya = y0 + (randu()-0.5) * s
yb = y0 + (randu()-0.5) * s
za = z0 + (randu()-0.5) * s
zb = z0 + (randu()-0.5) * s
i1 = add_point(xx1 ya za)
i2 = add_point(xx1 ya za+d)
i3 = add_point(xx2 yb zb)
call add_polygon(i1 i2 i3)
call meter_step()
end zi
end yi
call meter_end()
call add_end()
/* Perform the slice and leave only the points.
*/
call setblayer(fg)
call soliddrill(SLICE)
call removepols()
/* Delete the points that lie outside the bounding box of the
* original object, leaving the ones that intersected the interior
* surfaces. Then merge points using our min distance.
*/
call sel_mode(USER)
call sel_point(SET)
d = exb / 2
call sel_point(CLEAR, VOL, x1-d y1-d z1-d, x2+d y2+d z2+d)
call cut()
call mergepoints(md)
return
SETUP:
/* Setup state variables, reading stored ones, if any.
*/
num = 500
if (exists(statfil)) then do
if (~open(state, statfil, 'R')) then break
if (readln(state) ~= version) then break
parse value readln(state) with num .
call close state
end
/* Query user for their function and area to evaluate.
*/
call req_begin syscode
id_num = req_addcontrol("Approx Number of Points", 'n')
call req_setval id_divs, num, 500
if (~req_post()) then do
call req_end
return 0
end
num = req_getval(id_num) % 1
call req_end
/* Save state now, in case something fails.
*/
if (open(state, statfil, 'W')) then do
call writeln state, version
call writeln state, num
call close state
end
return 1